home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Utilities Experience
/
The Utilities Experience - Volume 1.iso
/
software
/
icons+tools
/
picticon
/
source
/
doloaddt.e
< prev
next >
Wrap
Text File
|
1995-12-22
|
51KB
|
1,686 lines
/*
DoLoadDT.m -- A datatype load, scale, remap and dither routine.
*/
/* $VER:doloaddt 0.88 (7.6.95) */
/*
THIS SOURCE IS COPYRIGHT 1994,1995 by Chad Randall, mbissaymssiK Software
If you wish to include this, or any modified version of this routine in your
own program, you *MUST* credit me somewhere in your program and/or documentation.
I am distributing this source mainly for those who wish to learn a thing or two.
Please don't rip me off.
*/
OPT MODULE
OPT PREPROCESS
MODULE 'exec/memory','exec/types'
MODULE 'dos/dos'
MODULE 'intuition/intuition','intuition/screens','intuition/gadgetclass'
MODULE 'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view',
'graphics/gfxbase','graphics/clip','graphics/layers','graphics/modeid'
MODULE 'iffparse','libraries/iffparse'
MODULE 'utility','utility/hooks','utility/tagitem'
MODULE 'datatypes','datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass'
MODULE 'mathffp'
MODULE 'gadtools','libraries/gadtools'
MODULE 'tools/boopsi'
MODULE 'mod/fonts'
MODULE 'mod/bits'
MODULE 'mod/compare'
MODULE 'mod/gadgets'
MODULE 'mod/gauge'
MODULE 'mod/macros'
MODULE 'mod/pool'
MODULE 'mod/color'
EXPORT OBJECT statwindow
scr:PTR TO screen
centerx:INT
centery:INT
textfont:PTR TO textfont
textattr:PTR TO textattr
textstyle:LONG
load_string:LONG
scale_string:LONG
histogram_string:LONG
quant_string:LONG
render_string:LONG
cancel_string:LONG
title_string:LONG
status_string:LONG
ENDOBJECT
EXPORT OBJECT gauge
rast:PTR TO rastport
scr:PTR TO screen
x:INT
y:INT
w:INT
h:INT
ENDOBJECT
EXPORT OBJECT imageinfo
source_w:LONG
source_h:LONG
destination_x:LONG
destination_y:LONG
destination_w:LONG
destination_h:LONG
depth:LONG
highest_pen:LONG
statwindowx:LONG
statwindowy:LONG
reserved3:LONG
reserved4:LONG
reserved5:LONG
reserved6:LONG
reserved7:LONG
reserved8:LONG
blackpen:LONG
whitepen:LONG
greypen:LONG
ENDOBJECT
/*OBJECT ditherarray
p1:CHAR
p2:CHAR
p3:CHAR
p4:CHAR
p5:CHAR
p6:CHAR
p7:CHAR
p8:CHAR
p9:CHAR
p10:CHAR
p11:CHAR
p12:CHAR
dividend:CHAR
ENDOBJECT*/
EXPORT ENUM DLDT_CENTER=TAG_USER, ->Centers image in w/h
DLDT_INTEGERSCALE, ->Does integer scaling routines. NOT FASTER, but may look better.
DLDT_DITHER, ->If =true then FS dithering is done
DLDT_REMAP, ->Use FindColor to remap pens?
DLDT_ASPECTX, ->x aspect value as in x:y
DLDT_ASPECTY, ->y aspect value
DLDT_SCALE, ->Should we scale, or crop? if=false then crop.
DLDT_USEASPECT, ->Should we use the aspect values, or do 1:1 to 1:1?
DLDT_ENLARGE, ->NOT IMPLEMENTED YET
DLDT_CLEAR, ->Clears from x->y, w->h
DLDT_GAUGE, ->A gauge struct.
DLDT_CLIGAUGE, ->A ptr to a STRING with an imbedded "%s" code.
DLDT_HOOK, ->A PROCedure (E!) to call periodically.
DLDT_INFO, ->A ptr to a imageinfo struct to be filled in.
DLDT_BIDIRECTIONAL, ->NOT IMPLEMENTED
DLDT_DIARRAY, ->NOT IMPLEMENTED
DLDT_HIGHPEN, ->Highest pen to use, -1 for all available. (default)
DLDT_FILLCMAP, -> Use DT cmap, and fill-in given cmap! no faint-hearts!!!
DLDT_GREYSCALE, -> create greyscale icon
DLDT_QUANTIZE, -> quantize to x number of colors
DLDT_CUSTOMFINDCOLOR, ->Use custom routine! OUCH
DLDT_RENDERHAM, -> if =6 then HAM6, if =8 then HAM8, else normal
DLDT_HAMTHRESHOLD, -> specifies when to use base-4 colors
DLDT_FULLHAMBASE,
DLDT_DISCARDERROR,
DLDT_STRETCHTOFIT,
DLDT_NORENDER,
DLDT_STATWINDOW,
DLDT_ACTIVATESTATWINDOW,
DLDT_DITHERTYPE,
DLDT_QUANTTYPE
EXPORT ENUM DITH_ERRORDIFF,DITH_FLOYD,DITH_STUCKI,DITH_BURKES
EXPORT ENUM QUANT_VERBATIM,QUANT_POPULARITY,QUANT_MEDIANCUT
DEF dtlib,utillib,ifflib,mathlib
#define PPM_GETR(p) (Shr(Shr(((p) AND $FF0000),8),8))
#define PPM_GETG(p) (Shr(((p) AND $FF00),8))
#define PPM_GETB(p) ((p) AND $FF)
#define PPM_PUTR(red) (Shl(Shl(((red) AND $FF),8),8))
#define PPM_PUTG(grn) (Shl(((grn) AND $FF),8))
#define PPM_PUTB(blu) ((blu) AND $FF)
#define PPM_ASSIGN(red,grn,blu) ((Shl(Shl(red AND $FF,8),8)) OR (Shl(grn AND $FF,8)) OR (blu AND $FF))
OBJECT box
ind:INT
colors:INT
sum:LONG
redw:CHAR
grnw:CHAR
bluw:CHAR
ENDOBJECT
CONST HASH_SIZE=20023
CONST MAXCOLORS=32767
#define HASHPIXEL(p) (Mod(((p) AND $ffffff),HASH_SIZE))
OBJECT colorhist_item
color:LONG
value:LONG
ENDOBJECT
OBJECT colorhist_list_item
ch:colorhist_item
next:PTR TO colorhist_list_item
ENDOBJECT
DEF statwindow:PTR TO window
DEF statgauge
DEF stat:PTR TO statwindow
DEF histopool
EXPORT PROC doloaddt(source,rast:PTR TO rastport,cmap:PTR TO colormap,x,y,w,h,taglist=0) HANDLE
DEF dtf=NIL:PTR TO dtframebox,fri=NIL:PTR TO frameinfo,obj=NIL:PTR TO datatypeheader,gpl=NIL:PTR TO gplayout
DEF dtrast=NIL:PTR TO rastport
DEF red[260]:LIST,grn[260]:LIST,blu[260]:LIST
DEF tag:PTR TO tagitem
DEF cregs,bm=NIL:PTR TO bitmap,bmhd=NIL:PTR TO bitmapheader,numcolors,modeid
DEF norender=FALSE
DEF center=FALSE,intscale=FALSE,dither=TRUE,remap=TRUE,aspectx=1,aspecty=1,scale=TRUE,useaspect=TRUE,enlarge=FALSE,clear=TRUE
DEF scalex,scaley,scalef
DEF res,res2
DEF trast=NIL:PTR TO rastport,tbm=NIL:PTR TO bitmap
DEF sfixx,sfixy
DEF ditz=0,dang=0,dumb=0,body
DEF usehighpen=-1
DEF fillcmap=FALSE
DEF cm
DEF hammode=FALSE,gauge=FALSE:PTR TO gauge,gaugestr=FALSE,hook=0
DEF i,t,u,v,z,xpixper=1,ypixper=1,step,stop
DEF scalarx,scalary,percent,adjustw,adjusth,finalw,finalh,finalx,finaly
DEF linebuf=0,redbuf=0,grnbuf=0,blubuf=0
DEF dithermode=DITH_FLOYD
DEF r38,g38,b38,r39,g39,b39
DEF stretch=FALSE
DEF statx=0,staty=0,statw=0,stath=0
DEF statgad=0
DEF glist=0,gad
DEF tmp1=0,tmp2=0,tmp3=0,tmp4=0,tmp5,tmp6,tmp7,tmp8,ttmp1,ttmp2,ttmp3
DEF lmp4,lmp5,lmp6
DEF er1,er2,er3,er4
DEF eg1,eg2,eg3,eg4
DEF eb1,eb2,eb3,eb4
DEF sumred=0,sumgrn=0,sumblu=0,num=0
DEF fc,reddif,grndif,bludif,grabbuf
DEF realred[260]:LIST,realgrn[260]:LIST,realblu[260]:LIST
DEF drawinfo=NIL:PTR TO drawinfo
DEF vis=0
DEF iinfo=0:PTR TO imageinfo
DEF highpen=0
DEF activatewindow=FALSE
DEF speed1,speed2,speed3,speed4,speed5,speed6,speed7,speed8
DEF red24=0,grn24=0,blu24=0
DEF grey=0,quant=256
DEF hamr,hamg,hamb
DEF hadr,hadg,hadb
DEF renderham=0,hamthres=64
DEF hambase=3
DEF discard=FALSE
DEF quantmode=QUANT_MEDIANCUT
DEF histo
-> WriteF('\n Start AVAILMEM-\d\n',AvailMem(MEMF_ANY))
histo:=0;statwindow:=0;statgauge:=0;stat:=0
dtf:=New(600);fri:=New(600);gpl:=New(600)
dtrast:=New(SIZEOF rastport);InitRastPort(dtrast)
trast:=New(SIZEOF rastport)
CopyMem(dtrast,trast,SIZEOF rastport);trast.layer:=0
IF checklibs()=FALSE THEN Raise("LIB")
IF taglist
IF (tag:=FindTagItem(DLDT_CENTER,taglist)) THEN center:=tag.data
IF (tag:=FindTagItem(DLDT_INTEGERSCALE,taglist)) THEN intscale:=tag.data
IF (tag:=FindTagItem(DLDT_DITHER,taglist)) THEN dither:=tag.data
IF (tag:=FindTagItem(DLDT_REMAP,taglist)) THEN remap:=tag.data
IF (tag:=FindTagItem(DLDT_ASPECTX,taglist)) THEN aspecty:=tag.data
IF (tag:=FindTagItem(DLDT_ASPECTY,taglist)) THEN aspectx:=tag.data
IF (tag:=FindTagItem(DLDT_SCALE,taglist)) THEN scale:=tag.data
IF (tag:=FindTagItem(DLDT_USEASPECT,taglist)) THEN useaspect:=tag.data
IF (tag:=FindTagItem(DLDT_ENLARGE,taglist)) THEN enlarge:=tag.data
IF (tag:=FindTagItem(DLDT_CLEAR,taglist)) THEN clear:=tag.data
IF (tag:=FindTagItem(DLDT_GAUGE,taglist)) THEN gauge:=tag.data
IF (tag:=FindTagItem(DLDT_CLIGAUGE,taglist)) THEN gaugestr:=tag.data
IF (tag:=FindTagItem(DLDT_HOOK,taglist)) THEN hook:=tag.data
IF (tag:=FindTagItem(DLDT_INFO,taglist)) THEN iinfo:=tag.data
IF (tag:=FindTagItem(DLDT_HIGHPEN,taglist)) THEN usehighpen:=tag.data
IF (tag:=FindTagItem(DLDT_FILLCMAP,taglist)) THEN fillcmap:=tag.data
IF (tag:=FindTagItem(DLDT_QUANTIZE,taglist)) THEN quant:=limit(tag.data,1,256)
IF (tag:=FindTagItem(DLDT_GREYSCALE,taglist)) THEN grey:=limit(tag.data,0,2)
IF (tag:=FindTagItem(DLDT_RENDERHAM,taglist)) THEN renderham:=limit(tag.data,0,8)
IF (tag:=FindTagItem(DLDT_HAMTHRESHOLD,taglist)) THEN hamthres:=limit(tag.data,0,760)
IF (tag:=FindTagItem(DLDT_FULLHAMBASE,taglist)) THEN IF (tag.data<>FALSE) THEN hambase:=IF (renderham=6) THEN 15 ELSE 63
IF (tag:=FindTagItem(DLDT_DISCARDERROR,taglist)) THEN discard:=tag.data
IF (tag:=FindTagItem(DLDT_STRETCHTOFIT,taglist)) THEN stretch:=tag.data
IF (tag:=FindTagItem(DLDT_NORENDER,taglist)) THEN norender:=tag.data
IF (tag:=FindTagItem(DLDT_STATWINDOW,taglist)) THEN stat:=tag.data
IF (tag:=FindTagItem(DLDT_ACTIVATESTATWINDOW,taglist)) THEN activatewindow:=tag.data
IF (tag:=FindTagItem(DLDT_DITHERTYPE,taglist)) THEN dithermode:=tag.data
IF (tag:=FindTagItem(DLDT_QUANTTYPE,taglist)) THEN quantmode:=tag.data
IF usehighpen=-1 THEN usehighpen:=256
IF (quant<256)
usehighpen:=limit(smaller(usehighpen,quant-1),1,255)
ENDIF
ENDIF
IF stat
drawinfo:=GetScreenDrawInfo(stat.scr)
vis:=GetVisualInfoA(stat.scr, NIL)
ENDIF
IF (stat AND drawinfo AND vis)
statw,stath:=biggest(rast,[stat.load_string,stat.scale_string,stat.histogram_string,stat.render_string,TAG_END]:LONG,stat.textfont,stat.textstyle)
tmp1,tmp2:=fontsize2(rast,stat.cancel_string,stat.textfont,stat.textstyle)
tmp8,tmp7:=fontsize2(rast,stat.status_string,stat.textfont,stat.textstyle)
statw:=bigger(bigger(statw,tmp1),tmp8)
tmp8:=bigger(tmp8,statw)
statx:=stat.centerx-(statw/2)
staty:=stat.centery-(stath/2)
tmp3:=(WFLG_SMART_REFRESH OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET)
IF activatewindow THEN tmp3:=tmp3 OR WFLG_ACTIVATE
statwindow:=OpenWindowTagList(0,
[WA_INNERWIDTH,statw+16,
WA_INNERHEIGHT,stath+26+tmp2+tmp7,
WA_LEFT,statx,
WA_TOP,staty,
WA_FLAGS,tmp3,
WA_TITLE,stat.title_string,
WA_CUSTOMSCREEN,stat.scr,
WA_IDCMP,(BUTTONIDCMP OR IDCMP_REFRESHWINDOW),
WA_NEWLOOKMENUS,TRUE,
WA_AUTOADJUST,TRUE,
NIL])
SetAPen(statwindow.rport,2)
SetBPen(statwindow.rport,0)
setafpt(statwindow.rport,[%1010101010101010,%0101010101010101]:INT,1)
SetDrMd(statwindow.rport,RP_JAM2)
RectFill(statwindow.rport,statwindow.borderleft,statwindow.bordertop,rightedge(statwindow)-1,bottomedge(statwindow)-1)
setafpt(statwindow.rport,0,0)
IF statwindow
gad:=CreateContext({glist})
tmp3:=(statwindow.width/2)-(tmp1/2)
tmp4:=(statwindow.height-statwindow.borderbottom-tmp2-6)
statgad,gad:=CreateGadgetA(BUTTON_KIND,gad,
[tmp3-6,tmp4,tmp1+12,tmp2+4,stat.cancel_string,stat.textattr,1,0,vis,0]:newgadget,[NIL,NIL])
AddGList(statwindow,statgad,-1,-1,0)
RefreshGList(statgad,statwindow,0,-1)
disablegadget(statgad,statwindow)
statgauge:=newgauge(statwindow.rport,statwindow.borderleft+2,statwindow.bordertop+10+tmp7,insidewidth(statwindow)-4,stath+8,stat.textfont,stat.textstyle,vis,drawinfo,GAUGETYPE_FANCY)
tmp1:=(statwindow.width/2)-(tmp8/2)
tmp2:=statwindow.bordertop+2
drawbevelbox(vis,statwindow.rport,tmp1-6,tmp2,tmp8+12,tmp7+4,1,TRUE,0)
Move(statwindow.rport,tmp1,stat.textfont.baseline+tmp2+2)
SetAPen(statwindow.rport,1)
SetFont(statwindow.rport,stat.textfont)
Text(statwindow.rport,stat.status_string,StrLen(stat.status_string))
statusgauge(statgauge,stat.load_string)
ENDIF
ENDIF
IF source<257
obj:=NewDTObjectA(source,[DTA_SOURCETYPE,DTST_CLIPBOARD,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL])
ELSE
obj:=NewDTObjectA(source,[DTA_SOURCETYPE,DTST_FILE,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL])
ENDIF
IF obj
IF (drawinfo=0) THEN IF (gauge) THEN drawinfo:=GetScreenDrawInfo(gauge.scr)
PutLong(dtf,DTM_FRAMEBOX)
dtf.frameinfo:=fri
dtf.contentsinfo:=fri
dtf.sizeframeinfo:=SIZEOF frameinfo
IF (domethod(obj,dtf))
PutLong(gpl,DTM_PROCLAYOUT)
gpl.ginfo:=NIL
gpl.initial:=1
IF (domethod(obj,gpl))
GetDTAttrsA(obj,[PDTA_CREGS,{cregs},PDTA_BITMAP,{bm},PDTA_NUMCOLORS,{numcolors},
PDTA_BITMAPHEADER,{bmhd},PDTA_MODEID,{modeid},NIL,NIL])
IF (modeid AND HAM_KEY);hammode:=TRUE;ENDIF
dtrast.bitmap:=bm
IF usehighpen=256 THEN usehighpen:=-1
IF bm<>NIL
body:=cregs
FOR i:=0 TO (Shl(1,(bmhd.depth))-1)
ditz:=Char(body);body:=body+4;red[i]:=ditz
dang:=Char(body);body:=body+4;grn[i]:=dang
dumb:=Char(body);body:=body+4;blu[i]:=dumb
ENDFOR
/* IF (fillcmap)
IF (grey>0)
speed2:=limit(smaller(quant,Shl(1,bmhd.depth)-1),1,255)
FOR i:=0 TO speed2-1
speed1:=((((i*100)/(speed2-1))*256)/100)
r38:=limit(speed1,0,255)
r38:=Shl(r38,8) OR r38
r38:=Shl(r38,8) OR r38
r38:=Shl(r38,8) OR r38
SetRGB32CM(cmap,smaller(i,255),r38,r38,r38)
ENDFOR
ENDIF
ENDIF*/
grabbuf:=[0,0,0,0,0,0,0,0]:LONG
tbm:=AllocBitMap((bmhd.width*2),1,8,(BMF_CLEAR OR BMF_STANDARD),NIL)
trast.bitmap:=tbm
adjustw:=SpFlt(bmhd.width)
adjusth:=SpFlt(bmhd.height)
IF ((useaspect<>FALSE) AND (intscale=FALSE))
IF bmhd.xaspect=0 THEN bmhd.xaspect:=1
IF bmhd.yaspect=0 THEN bmhd.yaspect:=1
scalarx:=SpDiv(SpFlt(aspectx),SpFlt(bmhd.xaspect))
scalary:=SpDiv(SpFlt(aspecty),SpFlt(bmhd.yaspect))
res:=SpCmp(scalarx,scalary)
IF res<0 -> scaraly is GREATER THAN scalarx
percent:=SpDiv(scalarx,scalary)
adjusth:=SpMul(percent,SpFlt(bmhd.height))
ELSE
percent:=SpDiv(scalary,scalarx)
adjustw:=SpMul(percent,SpFlt(bmhd.width))
ENDIF
ENDIF
finalx:=x;finaly:=y;finalw:=w;finalh:=h;scalex:=SpFlt(1);scaley:=SpFlt(1)
res:=SpCmp(SpFlt(w),adjustw)
res2:=SpCmp(SpFlt(h),adjusth)
IF (((res<0) OR (res2<0)) AND (scale<>FALSE)) -> Datatype is LARGER than workspace, so scale?
IF (intscale<>FALSE)
scalex:=SpFlt(SpFix( SpDiv(SpFlt(w),SpFlt(SpFix(adjustw)))))
scaley:=SpFlt(SpFix( SpDiv(SpFlt(h),SpFlt(SpFix(adjusth)))))
res:=SpCmp(scalex,scaley)
IF (res<0);scalef:=scaley;ELSE;scalef:=scalex;ENDIF
finalw:=SpFix(SpDiv(scalef,adjustw))
finalh:=SpFix(SpDiv(scalef,adjusth))
ELSE
scalex:=SpDiv(SpFlt(w),adjustw)
scaley:=SpDiv(SpFlt(h),adjusth)
res:=SpCmp(scalex,scaley)
IF (res<0);scalef:=scaley;ELSE;scalef:=scalex;ENDIF
finalw:=SpFix(SpDiv(scalef,adjustw))
finalh:=SpFix(SpDiv(scalef,adjusth))
ENDIF
IF (stretch)
finalw:=smaller(bmhd.width,w);finalh:=smaller(bmhd.height,h)
-> finalw:=w;finalh:=h
ENDIF
xpixper:=SpDiv(SpFlt(finalw),SpFlt(bmhd.width))
ypixper:=SpDiv(SpFlt(finalh),SpFlt(bmhd.height))
ELSE
finalw:=smaller(bmhd.width,w);finalh:=smaller(bmhd.height,h)
xpixper:=SpFlt(1);ypixper:=SpFlt(1)
ENDIF
IF center
finalx:=x+(w/2)-(finalw/2)
finaly:=y+(h/2)-(finalh/2)
ENDIF
IF statgauge THEN cleargauge(statgauge)
IF statgad THEN enablegadget(statgad,statwindow)
IF ((remap=FALSE) AND (scale=FALSE))
FOR t:=0 TO finalh-1
IF checkcancel(statwindow) THEN Raise("canc")
IF (((t+3)/4) = (t/4))
IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.render_string)
ENDIF
FOR i:=0 TO finalw-1
fc:=ReadPixel(dtrast,i,t)
WHILE fc>usehighpen
fc:=Shr(fc,1)
ENDWHILE
IF highpen<fc THEN highpen:=fc
SetAPen(rast,fc)
WritePixel(rast,finalx+i,finaly+t)
ENDFOR
ENDFOR
ELSE
redbuf:=New(bmhd.width*(SpFix(ypixper)*4)*2)
grnbuf:=New(bmhd.width*(SpFix(ypixper)*4)*2)
blubuf:=New(bmhd.width*(SpFix(ypixper)*4)*2)
linebuf:=New(bmhd.width*8)
speed2:=bmhd.width-1
speed3:=SpFix(ypixper)-1
speed4:=(finalw*12)+64
speed5:=finalw-1
sfixx:=SpFix(xpixper)-1
sfixy:=SpFix(ypixper)-1
red24:=New(finalw*(finalh+16))
grn24:=New(finalw*(finalh+16))
blu24:=New(finalw*(finalh+16))
FOR t:=0 TO (finalh-1)
IF checkcancel(statwindow) THEN Raise("canc")
IF (((t+3)/4) = (t/4))
IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.scale_string)
ENDIF
FOR u:=t TO t+speed3
ReadPixelLine8(dtrast,0,SpFix(SpMul(SpFlt(t),ypixper))+(u-t),bmhd.width,linebuf,trast)
speed8:=Char(linebuf)
tmp1:=red[speed8];tmp2:=grn[speed8];tmp3:=blu[speed8]
IF (hammode)
tmp1:=red[0];tmp2:=grn[0];tmp3:=blu[0]
IF bmhd.depth=8 -> HAM8
IF (speed8 AND %11000000)
IF ((speed8 AND %11000000)=%10000000) -> Modify RED
tmp1:=Shl((speed8 AND %111111),2);ENDIF
IF ((speed8 AND %11000000)=%01000000) -> Modify BLUE
tmp3:=Shl((speed8 AND %111111),2);ENDIF
IF ((speed8 AND %11000000)=%11000000) -> Modify GRN
tmp2:=Shl((speed8 AND %111111),2);ENDIF
ELSE
tmp1:=red[(speed8 AND %111111)];tmp2:=grn[(speed8 AND %111111)];tmp3:=blu[(speed8 AND %111111)]
ENDIF
ELSE
IF (speed8 AND %110000)
IF (speed8 AND %110000)=%100000 -> Modify RED
tmp1:=Shl((speed8 AND %1111),4);ENDIF
IF (speed8 AND %110000)=%010000 -> Modify BLUE
tmp3:=Shl((speed8 AND %1111),4);ENDIF
IF (speed8 AND %110000)=%110000 -> Modify GRN
tmp2:=Shl((speed8 AND %1111),4);ENDIF
ELSE
tmp1:=red[(z AND %1111)];tmp2:=grn[(z AND %1111)];tmp3:=blu[(z AND %1111)]
ENDIF
ENDIF
ENDIF
speed1:=bmhd.width*(u-t)
ditz:=redbuf+speed1
dang:=grnbuf+speed1
dumb:=blubuf+speed1
IF (remap=FALSE) THEN ditz:=redbuf
FOR v:=1 TO bmhd.width
IF (remap=FALSE)
PutChar(ditz,Char(linebuf+v));ditz:=ditz+1
ELSE
PutChar(ditz,tmp1);ditz:=ditz+1
PutChar(dang,tmp2);dang:=dang+1
PutChar(dumb,tmp3);dumb:=dumb+1
z:=Char(linebuf+v)
IF (hammode=FALSE)
tmp1:=red[z];tmp2:=grn[z];tmp3:=blu[z]
ELSE
IF (bmhd.depth=8) -> HAM8
speed7:=(z AND %11000000)
IF (speed7)
IF (speed7=%10000000) -> Modify RED
tmp1:=Shl((z AND %111111),2)
ELSE
IF (speed7=%01000000)
tmp3:=Shl((z AND %111111),2)
ELSE
tmp2:=Shl((z AND %111111),2)
ENDIF
ENDIF
ELSE
speed6:=(z AND %111111)
tmp1:=red[speed6];tmp2:=grn[speed6];tmp3:=blu[speed6]
ENDIF
ELSE
IF (z AND %110000)
IF (z AND %110000)=%100000 -> Modify RED
tmp1:=Shl((z AND %1111),4);ENDIF
IF (z AND %110000)=%010000 -> Modify BLUE
tmp3:=Shl((z AND %1111),4);ENDIF
IF (z AND %110000)=%110000 -> Modify GRN
tmp2:=Shl((z AND %1111),4);ENDIF
ELSE
speed6:=(z AND %1111)
tmp1:=red[speed6];tmp2:=grn[speed6];tmp3:=blu[speed6]
ENDIF
ENDIF
ENDIF
ENDIF
ENDFOR
ENDFOR
IF (remap=FALSE)
FOR i:=0 TO speed5
fc:=Char(redbuf+(SpFix(SpMul(xpixper,SpFlt(i)))))
SetAPen(rast,fc)
highpen:=bigger(highpen,fc)
WritePixel(rast,finalx+i,finaly+t)
ENDFOR
ELSE
FOR i:=0 TO speed5
tmp4:=(SpFix(SpMul(xpixper,SpFlt(i))))
ditz:=redbuf+tmp4
dang:=grnbuf+tmp4
dumb:=blubuf+tmp4
IF ((sfixy>=1) AND (sfixx>=1))
num:=0;sumred:=0;sumgrn:=0;sumblu:=0
MOVEM.L D0-D7/A0-A3,-(A7)
MOVE.L ditz,A0
MOVE.L dang,A1
MOVE.L dumb,A2
MOVE.L bmhd,A3
CLR.L D2 -> The result from Char()
CLR.L D4 -> num
CLR.L D5 -> sumred
CLR.L D6 -> sumgrn
CLR.L D7 -> sumblu
MOVE.L sfixy,D0
-> ADD.L #1,D0
loop3:
MOVE.L sfixx,D1
-> ADD.L #1,D1
loop2:
SUB.L D3,D3 -> EQ: CLR.L D3 ? Is it faster??!?
MOVE.W 0(A3),D3
MULU.L D0,D3
ADD.L D1,D3
MOVE.B 0(A0,D3),D2
ADD.L D2,D5
MOVE.B 0(A1,D3),D2
ADD.L D2,D6
MOVE.B 0(A2,D3),D2
ADD.L D2,D7
ADDQ.L #1,D4
DBRA D1,loop2
DBRA D0,loop3
MOVE.L D4,num
MOVE.L D5,sumred
MOVE.L D6,sumgrn
MOVE.L D7,sumblu
MOVEM.L (A7)+,D0-D7/A0-A3
IF num>0
sumred:=limit(sumred/num,0,255)
sumgrn:=limit(sumgrn/num,0,255)
sumblu:=limit(sumblu/num,0,255)
ENDIF
ELSE
sumred:=Char(ditz)
sumgrn:=Char(dang)
sumblu:=Char(dumb)
ENDIF
MOVE.L t,D1
MOVE.L finalw,D2
MULU.L D2,D1
ADD.L i,D1
MOVE.L D1,D0
ADD.L red24,D0
MOVE.L D0,A0
MOVE.L sumred,D2
MOVE.B D2,(A0)
MOVE.L D1,D0
ADD.L grn24,D0
MOVE.L D0,A0
MOVE.L sumgrn,D2
MOVE.B D2,(A0)
MOVE.L D1,D0
ADD.L blu24,D0
MOVE.L D0,A0
MOVE.L sumblu,D2
MOVE.B D2,(A0)
ENDFOR
ENDIF
ENDFOR
IF grey
tmp1:=red24
tmp2:=grn24
tmp3:=blu24
tmp7:=finalh*finalw-1
FOR i:=0 TO tmp7
IF grey=1
er1:=(Char(tmp1)*1000)/30
er2:=(Char(tmp2)*1000)/30
er3:=(Char(tmp3)*1000)/30
ELSE
er1:=(Char(tmp1)*3000)/100
er2:=(Char(tmp2)*6000)/100
er3:=(Char(tmp3)*1000)/100
ENDIF
er4:=(er1+er2+er3)/100
PutChar(tmp1,er4)
PutChar(tmp2,er4)
PutChar(tmp3,er4)
tmp1:=tmp1+1
tmp2:=tmp2+1
tmp3:=tmp3+1
ENDFOR
ENDIF
IF (fillcmap)
IF usehighpen>=quant THEN usehighpen:=(quant-1)
SELECT quantmode
CASE QUANT_VERBATIM
FOR i:=0 TO quant
SetRGB32CM(cmap,smaller(i,255),byte2long(red[i]),byte2long(grn[i]),byte2long(blu[i]))
ENDFOR
CASE QUANT_POPULARITY
histo:=New(20000)
FOR t:=0 TO finalh-1
IF checkcancel(statwindow) THEN Raise("canc")
IF (((t+3)/4)=(t/4))
IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.histogram_string)
ENDIF
FOR i:=0 TO finalw-1
tmp1:=Shr((Char(red24+(t*finalw)+i) AND $F0) ,4)
tmp2:=Shr((Char(grn24+(t*finalw)+i) AND $F0) ,4)
tmp3:=Shr((Char(blu24+(t*finalw)+i) AND $F0) ,4)
tmp4:=histo+((tmp1+(tmp2*16)+(tmp3*256))*4)
PutLong(tmp4,(Long(tmp4)+1))
ENDFOR
ENDFOR
FOR i:=0 TO quant
IF checkcancel(statwindow) THEN Raise("canc")
IF (((i+3)/4)=(i/4))
IF statgauge THEN fuelgauge(statgauge,i,quant,stat.quant_string)
ENDIF
tmp1:=0
tmp2:=0
tmp3:=histo
FOR t:=0 TO 4095
IF Long(tmp3)>tmp2
tmp2:=Long(tmp3)
tmp1:=t
ENDIF
tmp3:=tmp3+4
ENDFOR
PutLong(histo+(tmp1*4),0)
er1:=tmp1 AND $F
er1:=er1 OR Shl(er1,4)
er2:=Shr((tmp1 AND $F0),4)
er2:=er2 OR Shl(er2,4)
er3:=Shr((tmp1 AND $F00),8)
er3:=er3 OR Shl(er3,4)
SetRGB32CM(cmap,smaller(i,255),byte2long(er1),byte2long(er2),byte2long(er3))
ENDFOR
CASE QUANT_MEDIANCUT
cm:=domediancut(red24,grn24,blu24,finalw,finalh,cmap,quant)
IF (cm)
FOR i:=0 TO (quant)
SetRGB32CM(cmap,smaller(i,255),byte2long(PPM_GETR(Long(cm+(i*SIZEOF colorhist_item)))),byte2long(PPM_GETG(Long(cm+(i*SIZEOF colorhist_item)))),byte2long(PPM_GETB(Long(cm+(i*SIZEOF colorhist_item)))))
ENDFOR
Dispose(cm)
ENDIF
ENDSELECT
doexchange(cmap,3,0,255,255,usehighpen)
doexchange(cmap,2,255,255,255,usehighpen)
doexchange(cmap,1,0,0,0,usehighpen)
doexchange(cmap,0,128,128,128,usehighpen)
ENDIF
IF (norender) THEN Raise("nore")
IF (clear<>FALSE);SetAPen(rast,0);RectFill(rast,x,y,x+w-1,y+h-1);ENDIF
FOR i:=0 TO Shl(1,8)-1
GetRGB32(cmap,i,1,grabbuf)
realred[i]:=Char(grabbuf)
realgrn[i]:=Char(grabbuf+4)
realblu[i]:=Char(grabbuf+8)
ENDFOR
IF renderham THEN dither:=FALSE
FOR t:=0 TO finalh-1
IF checkcancel(statwindow) THEN Raise("canc")
IF (((t+3)/4)=(t/4))
IF ((gauge<>0) AND (drawinfo<>0))
IF (gauge.rast<>0)
SetAPen(gauge.rast,Int(drawinfo.pens+(FILLPEN*2)))
RectFill(gauge.rast,gauge.x,gauge.y,gauge.x+((((gauge.w-2)*100)/(10000/(bigger((t*100/(finalh-1)),1))))),gauge.y+gauge.h-1)
ENDIF
ENDIF
IF (gaugestr<>0)
WriteF(gaugestr,smaller(((t*100))/(bigger(finalh-1,1)),100))
ENDIF
IF statgauge THEN fuelgauge(statgauge,t,finalh-1,stat.render_string)
ENDIF
IF ((((t+1)/2)=(t/2)) OR (renderham>5) OR (dithermode=DITH_ERRORDIFF))
i:=0;stop:=finalw;step:=1
tmp4:=t*finalw
tmp1:=red24+tmp4
tmp2:=grn24+tmp4
tmp3:=blu24+tmp4
ELSE
i:=finalw-1;stop:=-1;step:=-1
tmp4:=(t*finalw)+(finalw-1)
tmp1:=red24+tmp4
tmp2:=grn24+tmp4
tmp3:=blu24+tmp4
ENDIF
REPEAT
tmp4:=Char(tmp1)
tmp5:=Char(tmp2)
tmp6:=Char(tmp3)
lmp4:=byte2long(tmp4)
lmp5:=byte2long(tmp5)
lmp6:=byte2long(tmp6)
IF (dither=FALSE)
SELECT 9 OF renderham
CASE 6,8
IF (i>0)
fc:=FindColor(cmap,lmp4,lmp5,lmp6,hambase)
hadr:=Abs(tmp4-realred[fc])
hadg:=Abs(tmp5-realgrn[fc])
hadb:=Abs(tmp6-realblu[fc])
IF ((hadr+hadg+hadb)<=hamthres)
hamr:=realred[fc] -> CHAR
hamg:=realgrn[fc]
hamb:=realblu[fc]
ELSE
hadr:=Abs(tmp4-hamr) -> CHAR-CHAR
hadg:=Abs(tmp5-hamg)
hadb:=Abs(tmp6-hamb)
IF (renderham=8)
IF ((hadb>(hadr*2)) AND (hadb>(hadg*3)))
hamb:=(tmp6 AND %11111100)
fc:=(%01000000 OR Shr(hamb,2))
IF (discard) THEN hamb:=(tmp6 AND %11111111)
ELSE
IF (hadr>(hadg*2))
hamr:=(tmp4 AND %11111100)
fc:=(%10000000 OR Shr(hamr,2))
IF (discard) THEN hamr:=(tmp4 AND %11111111)
ELSE
hamg:=(tmp5 AND %11111100)
fc:=(%11000000 OR Shr(hamg,2))
IF (discard) THEN hamg:=(tmp5 AND %11111111)
ENDIF
ENDIF
ELSE
IF ((hadb>(hadr*2)) AND (hadb>(hadg*3)))
hamb:=(tmp6 AND %11110000)
fc:=(%010000 OR Shr(hamb,4))
IF (discard) THEN hamb:=(tmp6 AND %11111111)
ELSE
IF (hadr>(hadg*2))
hamr:=(tmp4 AND %11110000)
fc:=(%100000 OR Shr(hamr,4))
IF (discard) THEN hamr:=(tmp4 AND %11111111)
ELSE
hamg:=(tmp5 AND %11110000)
fc:=(%110000 OR Shr(hamg,4))
IF (discard) THEN hamg:=(tmp5 AND %11111111)
ENDIF
ENDIF
ENDIF
ENDIF
ELSE
fc:=FindColor(cmap,lmp4,lmp5,lmp6,hambase)
hamr:=realred[fc]
hamg:=realgrn[fc]
hamb:=realblu[fc]
ENDIF
DEFAULT
fc:=FindColor(cmap,lmp4,lmp5,lmp6,usehighpen)
ENDSELECT
IF fc>highpen THEN highpen:=fc
SetAPen(rast,fc)
WritePixel(rast,finalx+i,finaly+t)
ELSE -> Do dither!
fc:=FindColor(cmap,lmp4,lmp5,lmp6,usehighpen)
IF fc>highpen THEN highpen:=fc
SetAPen(rast,fc)
WritePixel(rast,finalx+i,finaly+t)
reddif:=tmp4-realred[fc]
grndif:=tmp5-realgrn[fc]
bludif:=tmp6-realblu[fc]
SELECT 4 OF dithermode
CASE DITH_FLOYD,DITH_ERRORDIFF
IF dithermode=DITH_FLOYD
er1:=(reddif*7)/16
er2:=(reddif*3)/16
er3:=(reddif*5)/16
er4:=reddif-er1-er2-er3
eg1:=(grndif*7)/16
eg2:=(grndif*3)/16
eg3:=(grndif*5)/16
eg4:=grndif-eg1-eg2-eg3
eb1:=(bludif*7)/16
eb2:=(bludif*3)/16
eb3:=(bludif*5)/16
eb4:=bludif-eb1-eb2-eb3
ELSE
er1:=(reddif*3)/8 AND %11111111111111111111111111111110
er2:=0
er3:=er1
er4:=reddif-er1-er3 AND %11111111111111111111111111111100
eg1:=(grndif*3)/8 AND %11111111111111111111111111111100
eg2:=0
eg3:=eg1
eg4:=grndif-eg1-eg3 AND %11111111111111111111111111111100
eb1:=(bludif*3)/8 AND %11111111111111111111111111111110
eb2:=0
eb3:=eb1
eb4:=bludif-eb1-eb3 AND %11111111111111111111111111111100
ENDIF
IF step=1
IF ((i+1)<stop)
byteplace(tmp1+1,er1)
byteplace(tmp2+1,eg1)
byteplace(tmp3+1,eb1)
ENDIF
IF t<(finalh-1)
IF ((i+1)<stop)
byteplace(tmp1+1+finalw,er4)
byteplace(tmp2+1+finalw,eg4)
byteplace(tmp3+1+finalw,eb4)
ENDIF
IF (i>0)
byteplace(tmp1-1+finalw,er2)
byteplace(tmp2-1+finalw,eg2)
byteplace(tmp3-1+finalw,eb2)
ENDIF
byteplace(tmp1+finalw,er3)
byteplace(tmp2+finalw,eg3)
byteplace(tmp3+finalw,eb3)
ENDIF
ELSE
IF ((i-1)>stop)
byteplace(tmp1-1,er1)
byteplace(tmp2-1,eg1)
byteplace(tmp3-1,eb1)
ENDIF
IF t<(finalh-1)
IF ((i-1)>stop)
byteplace(tmp1-1+finalw,er4)
byteplace(tmp2-1+finalw,eg4)
byteplace(tmp3-1+finalw,eb4)
ENDIF
IF (i<(finalw-1))
byteplace(tmp1+1+finalw,er2)
byteplace(tmp2+1+finalw,eg2)
byteplace(tmp3+1+finalw,eb2)
ENDIF
byteplace(tmp1+finalw,er3)
byteplace(tmp2+finalw,eg3)
byteplace(tmp3+finalw,eb3)
ENDIF
ENDIF
CASE DITH_BURKES,DITH_STUCKI
IF dithermode=DITH_BURKES
er1:=(reddif*8)/32 ->8
er2:=(reddif*4)/32 ->4
er3:=(reddif-(er1*2)-(er2*3))/2 ->2
eg1:=(grndif*8)/32
eg2:=(grndif*4)/32
eg3:=(grndif-(eg1*2)-(eg2*3))/2
eb1:=(bludif*8)/32
eb2:=(bludif*4)/32
eb3:=(bludif-(eb1*2)-(eb2*3))/2
ELSE
er1:=(reddif*8)/42 ->8
er2:=(reddif*4)/42 ->4
er3:=(reddif*2)/42 ->2
er4:=(reddif-(er1*2)-(er2*4)-(er3*4))/2 ->1
eg1:=(grndif*8)/42
eg2:=(grndif*4)/42
eg3:=(grndif*2)/42
eg4:=(grndif-(eg1*2)-(eg2*4)-(eg3*4))/2
eb1:=(bludif*8)/42
eb2:=(bludif*4)/42
eb3:=(bludif*2)/42
eb4:=(bludif-(eb1*2)-(eb2*4)-(eb3*4))/2
ENDIF
IF step=1
IF ((i+1)<stop)
byteplace(tmp1+1,er1)
byteplace(tmp2+1,eg1)
byteplace(tmp3+1,eb1)
IF ((i+2)<stop)
byteplace(tmp1+2,er2)
byteplace(tmp2+2,eg2)
byteplace(tmp3+2,eb2)
ENDIF
ENDIF
IF t<(finalh-1)
ttmp1:=tmp1+finalw
ttmp2:=tmp2+finalw
ttmp3:=tmp3+finalw
IF ((i+1)<stop)
byteplace(ttmp1+1,er2)
byteplace(ttmp2+1,eg2)
byteplace(ttmp3+1,eb2)
IF ((i+2)<stop)
byteplace(ttmp1+2,er3)
byteplace(ttmp2+2,eg3)
byteplace(ttmp3+2,eb3)
ENDIF
ENDIF
IF (i>0)
byteplace(ttmp1-1,er2)
byteplace(ttmp2-1,eg2)
byteplace(ttmp3-1,eb2)
IF (i>1)
byteplace(ttmp1-2,er3)
byteplace(ttmp2-2,eg3)
byteplace(ttmp3-2,eb3)
ENDIF
ENDIF
byteplace(ttmp1,er1)
byteplace(ttmp2,eg1)
byteplace(ttmp3,eb1)
IF dithermode=DITH_STUCKI
IF t<(finalh-1)
ttmp1:=ttmp1+finalw
ttmp2:=ttmp2+finalw
ttmp3:=ttmp3+finalw
IF ((i+1)<stop)
byteplace(ttmp1+1,er3)
byteplace(ttmp2+1,eg3)
byteplace(ttmp3+1,eb3)
IF ((i+2)<stop)
byteplace(ttmp1+2,er4)
byteplace(ttmp2+2,eg4)
byteplace(ttmp3+2,eb4)
ENDIF
ENDIF
IF (i>0)
byteplace(ttmp1-1,er3)
byteplace(ttmp2-1,eg3)
byteplace(ttmp3-1,eb3)
IF (i>1)
byteplace(ttmp1-2,er4)
byteplace(ttmp2-2,eg4)
byteplace(ttmp3-2,eb4)
ENDIF
ENDIF
byteplace(ttmp1,er2)
byteplace(ttmp2,eg2)
byteplace(ttmp3,eb2)
ENDIF
ENDIF
ENDIF
ELSE
IF ((i-1)>stop)
byteplace(tmp1-1,er1)
byteplace(tmp2-1,eg1)
byteplace(tmp3-1,eb1)
IF ((i-2)>stop)
byteplace(tmp1-2,er2)
byteplace(tmp2-2,eg2)
byteplace(tmp3-2,eb2)
ENDIF
ENDIF
IF t<(finalh-1)
ttmp1:=tmp1+finalw
ttmp2:=tmp2+finalw
ttmp3:=tmp3+finalw
IF ((i-1)>stop)
byteplace(ttmp1-1,er2)
byteplace(ttmp2-1,eg2)
byteplace(ttmp3-1,eb2)
IF ((i-2)>stop)
byteplace(ttmp1-2,er3)
byteplace(ttmp2-2,eg3)
byteplace(ttmp3-2,eb3)
ENDIF
ENDIF
IF (i<(finalw-1))
byteplace(ttmp1+1,er2)
byteplace(ttmp2+1,eg2)
byteplace(ttmp3+1,eb2)
IF (i<(finalw-2))
byteplace(ttmp1+2,er3)
byteplace(ttmp2+2,eg3)
byteplace(ttmp3+2,eb3)
ENDIF
ENDIF
byteplace(ttmp1,er1)
byteplace(ttmp2,eg1)
byteplace(ttmp3,eb1)
IF dithermode=DITH_STUCKI
IF (t<(finalh-1))
ttmp1:=ttmp1+finalw
ttmp2:=ttmp2+finalw
ttmp3:=ttmp3+finalw
IF ((i-1)>stop)
byteplace(ttmp1-1,er3)
byteplace(ttmp2-1,eg3)
byteplace(ttmp3-1,eb3)
IF ((i-2)>stop)
byteplace(ttmp1-2,er4)
byteplace(ttmp2-2,eg4)
byteplace(ttmp3-2,eb4)
ENDIF
ENDIF
IF (i<(finalw-1))
byteplace(ttmp1+1,er3)
byteplace(ttmp2+1,eg3)
byteplace(ttmp3+1,eb3)
IF (i<(finalw-2))
byteplace(ttmp1+2,er4)
byteplace(ttmp2+2,eg4)
byteplace(ttmp3+2,eb4)
ENDIF
ENDIF
byteplace(ttmp1,er2)
byteplace(ttmp2,eg2)
byteplace(ttmp3,eb2)
ENDIF
ENDIF
ENDIF
ENDIF
ENDSELECT
ENDIF
tmp1:=tmp1+step
tmp2:=tmp2+step
tmp3:=tmp3+step
i:=i+step;UNTIL i=stop
ENDFOR
ENDIF
IF (renderham=6) THEN highpen:=63
IF (renderham=8) THEN highpen:=255
IF iinfo
iinfo.source_w:=bmhd.width
iinfo.source_h:=bmhd.height
iinfo.destination_x:=finalx
iinfo.destination_y:=finaly
iinfo.destination_w:=finalw
iinfo.destination_h:=finalh
iinfo.depth:=bmhd.depth
iinfo.highest_pen:=highpen
IF ((renderham=6) OR (renderham=8)) THEN usehighpen:=3
iinfo.blackpen:=FindColor(cmap,0,0,0,usehighpen)
iinfo.whitepen:=FindColor(cmap,$FFFFFFFF,$FFFFFFFF,$FFFFFFFF,usehighpen)
iinfo.greypen:=FindColor(cmap,$99999999,$99999999,$99999999,usehighpen)
IF statwindow
iinfo.statwindowx:=stat.centerx-(statx-statwindow.leftedge)
iinfo.statwindowy:=stat.centery-(staty-statwindow.topedge)
ENDIF
ENDIF
IF (gaugestr<>0)
WriteF(gaugestr,100)
ENDIF
ELSE
Raise("MEM")
ENDIF
ELSE
Raise("Nodt")
ENDIF
ELSE
Raise("Nodt")
ENDIF
ELSE
Raise("Nodt")
ENDIF
EXCEPT DO
res:=exception
IF statwindow
CloseWindow(statwindow)
IF glist
FreeGadgets(glist)
ENDIF
statwindow:=0
ENDIF
IF statgauge THEN endgauge(statgauge)
IF drawinfo THEN FreeScreenDrawInfo(gauge.scr,drawinfo)
IF vis THEN FreeVisualInfo(vis)
IF obj THEN DisposeDTObject(obj)
IF tbm THEN FreeBitMap(tbm)
IF redbuf THEN Dispose(redbuf)
IF grnbuf THEN Dispose(grnbuf)
IF blubuf THEN Dispose(blubuf)
IF linebuf THEN Dispose(linebuf)
IF trast THEN Dispose(trast)
IF dtf THEN Dispose(dtf)
IF fri THEN Dispose(fri)
IF histo THEN Dispose(histo)
IF red24 THEN Dispose(red24)
IF grn24 THEN Dispose(grn24)
IF blu24 THEN Dispose(blu24)
IF gpl THEN Dispose(gpl)
IF dtrast THEN Dispose(dtrast)
->WriteF('\n End AVAILMEM-\d\n',AvailMem(MEMF_ANY))
ENDPROC res
PROC checklibs()
IF ((iffparsebase) AND (utilitybase) AND (datatypesbase) AND (mathbase)) THEN RETURN TRUE
ENDPROC FALSE
PROC checkcancel(window:PTR TO window)
DEF mes:PTR TO intuimessage
DEF class
DEF retu=FALSE
IF window
REPEAT
IF mes:=Gt_GetIMsg(window.userport)
class:=extractmessage(mes)
IF (class=IDCMP_GADGETUP)
retu:=TRUE
ELSEIF class=IDCMP_REFRESHWINDOW
Gt_BeginRefresh(window)
Gt_EndRefresh(window,TRUE)
ENDIF
Gt_ReplyIMsg(mes)
ENDIF
UNTIL mes=0
ELSE
IF CtrlC() THEN retu:=TRUE
ENDIF
ENDPROC retu
PROC byteplace(loc,error)
DEF old
old:=Char(loc)
old:=old+error
IF old<0 THEN old:=0
IF old>255 THEN old:=255
PutChar(loc,old)
ENDPROC
PROC rgbint(intval)
DEF r,g,b
r:=intval AND $F
r:=r OR Shl(r,4)
g:=Shr((intval AND $F0),4)
g:=g OR Shl(g,4)
b:=Shr((intval AND $F00),8)
b:=b OR Shl(b,4)
ENDPROC r,g,b
PROC rgb2int(r,g,b)
DEF int=0
int:=(Shr(r,4) OR (Shl(Shr(g,4),4)) OR (Shl(Shr(b,4),8)) )
ENDPROC int
PROC rgbtab(r,g,b)
DEF rr
rr:=(r+(g*16)+(b*256))*4
ENDPROC rr
PROC domediancut(redbuf,grnbuf,blubuf,width,height,palette,newcolors)
DEF chv=0:PTR TO colorhist_item
DEF colors=0
DEF colormap
histopool:=createpool()
chv:=computecolorhist(redbuf,grnbuf,blubuf,width,height,MAXCOLORS,{colors})
IF chv
-> WriteF('\n\nFOUND \d COLORS! -- Choosing \d colors...\n\n',colors,newcolors)
colormap:=mediancut(chv,colors,width*height,newcolors)
Dispose(chv)
ENDIF
ENDPROC colormap
PROC mediancut(chv,colors,sum,newcolors)
DEF colormap=0,bv=0
DEF boxes,bi,i,bigbox,movebox,tmp1,tmp2,score
DEF box:PTR TO box,chi:PTR TO colorhist_item
DEF indx,clrs,sm,minr,maxr,ming,maxg,minb,maxb,v,halfsum,lowersum
DEF r,g,b
DEF rl,gl,bl
DEF f_0_299,f_0_587,f_0_114
DEF colo
bv:=New((SIZEOF box*newcolors)+100)
f_0_299:=SpDiv(SpFlt(1000),SpFlt(299))
f_0_587:=SpDiv(SpFlt(1000),SpFlt(587))
f_0_114:=SpDiv(SpFlt(1000),SpFlt(114))
IF (bv)
colormap:=New((SIZEOF colorhist_item*newcolors)+100)
IF (colormap)
FOR i:=0 TO (newcolors-1)
PutLong(colormap+(i*SIZEOF colorhist_item),0)
PutLong(colormap+(i*SIZEOF colorhist_item)+4,0)
ENDFOR
box:=bv
box.ind:=0
box.colors:=colors
box.sum:=sum
boxes:=1
sizebox(box,chv)
WHILE (boxes<newcolors)
IF checkcancel(statwindow)
IF chv THEN Dispose(chv)
IF bv THEN Dispose(bv)
IF colormap THEN Dispose(colormap)
Raise("canc")
ENDIF
IF (((boxes+1)/2)<>(boxes/2))
IF statgauge THEN fuelgauge(statgauge,boxes,newcolors,stat.quant_string)
ENDIF
FOR bi:=0 TO (boxes-1)
box:=bv+(bi*SIZEOF box)
IF box.colors>=2 THEN JUMP break2
ENDFOR
JUMP break3
break2:
-> IF (bi=boxes) THEN JUMP break3
indx:=box.ind
clrs:=box.colors
sm:=box.sum
rl:=SpMul(SpFlt(box.redw),f_0_299)
gl:=SpMul(SpFlt(box.grnw),f_0_587)
bl:=SpMul(SpFlt(box.bluw),f_0_114)
rl:=SpFlt(box.redw)
gl:=SpFlt(box.grnw)
bl:=SpFlt(box.bluw)
/* rl:=SpMul(SpFlt(box.bluw),f_0_299)
gl:=SpMul(SpFlt(box.grnw),f_0_587)
bl:=SpMul(SpFlt(box.bluw),f_0_114)
chi:=chv+(indx*SIZEOF colorhist_item)
colo:=chi.color
minr:=PPM_GETR(colo);maxr:=minr
ming:=PPM_GETG(colo);maxg:=ming
minb:=PPM_GETB(colo);maxb:=minb
FOR i:=1 TO (clrs-1)
chi:=chv+((indx+i)*SIZEOF colorhist_item)
colo:=chi.color
v:=PPM_GETR(colo)
IF (v<minr) THEN minr:=v
IF (v>maxr) THEN maxr:=v
v:=PPM_GETG(colo)
IF (v<ming) THEN ming:=v
IF (v>maxg) THEN maxg:=v
v:=PPM_GETB(colo)
IF (v<minb) THEN minb:=v
IF (v>maxb) THEN maxb:=v
ENDFOR
rl:=SpMul(SpFlt(maxr-minr),f_0_299)
gl:=SpMul(SpFlt(maxg-ming),f_0_587)
bl:=SpMul(SpFlt(maxb-minb),f_0_114)*/
IF ((SpCmp(rl,gl)>0) AND (SpCmp(rl,bl)>0))
qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF0000)
/*
WriteF('\n------------RED--------------')
FOR i:=0 TO clrs-1
chi:=chv+((i+indx)*SIZEOF colorhist_item)
WriteF('\n\h[8] \d[6]',chi.color,chi.value)
ENDFOR
*/
ELSE
IF (SpCmp(gl,bl)>0)
qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF00)
/*
WriteF('\n------------GRN--------------')
FOR i:=0 TO clrs-1
chi:=chv+((i+indx)*SIZEOF colorhist_item)
WriteF('\n\h[8] \d[6]',chi.color,chi.value)
ENDFOR
*/
ELSE
qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF)
/*
WriteF('\n------------BLU--------------')
FOR i:=0 TO clrs-1
chi:=chv+((i+indx)*SIZEOF colorhist_item)
WriteF('\n\h[8] \d[6]',chi.color,chi.value)
ENDFOR
*/
ENDIF
ENDIF
chi:=chv+(indx*SIZEOF colorhist_item)
lowersum:=chi.value
halfsum:=(sm/2)
->WriteF('\n\d,',lowersum)
i:=1
WHILE (i<(clrs-1))
IF (lowersum>=halfsum) THEN JUMP break4
chi:=chv+((indx+i)*SIZEOF colorhist_item)
lowersum:=lowersum+(chi.value)
->WriteF('\d,',lowersum)
i:=i+1;ENDWHILE
break4:
lowersum:=limit(lowersum,0,sm-1)
box:=bv+(bi*SIZEOF box)
box.colors:=i
box.sum:=lowersum
sizebox(box,chv)
box:=bv+(boxes*SIZEOF box)
box.ind:=indx+i
box.colors:=clrs-i
box.sum:=sm-lowersum
sizebox(box,chv)
boxes:=boxes+1
/* IF (box.sum<=0)
WriteF('\nSMALL SUM=\d \d \d',box.sum,sm,lowersum)
ENDIF*/
bigbox:=0;movebox:=0
box:=bv
FOR i:=1 TO boxes-1
box:=(box+SIZEOF box)
IF (box.colors>1)
score:=(((box.redw*box.redw))+((box.grnw*box.grnw))+(box.bluw*box.bluw))
->*(box.sum)
IF score>bigbox;movebox:=i;bigbox:=score;ENDIF
/*
IF box.redw>bigbox;bigbox:=box.redw;movebox:=i
WriteF(' R-\d',bigbox)
ENDIF
IF box.grnw>bigbox;bigbox:=box.grnw;movebox:=i
WriteF(' G-\d',bigbox)
ENDIF
IF box.bluw>bigbox;bigbox:=box.bluw;movebox:=i
WriteF(' B-\d',bigbox)
ENDIF
*/
ENDIF
ENDFOR
-> WriteF('\nbigbox=\d',bigbox)
swapboxes(bv,bv+(movebox*SIZEOF box))
/*
WriteF('------\n')
FOR i:=0 TO boxes-1
box:=bv+(i*SIZEOF box)
WriteF('\d[4] \d[6] \d[6] (\d[3],\d[3],\d[3])\n',box.ind,box.colors,box.sum,box.redw,box.grnw,box.bluw)
ENDFOR
WriteF('------\n')
*/
ENDWHILE
break3:
FOR bi:=0 TO (boxes-1)
box:=bv+(bi*SIZEOF box)
indx:=box.ind
clrs:=box.colors
r:=0;g:=0;b:=0;sum:=0
FOR i:=0 TO (clrs-1)
chi:=chv+((indx+i)*SIZEOF colorhist_item)
colo:=chi.color
tmp1:=chi.value
-> r:=r+((PPM_GETR(colo))*tmp1)
-> g:=g+((PPM_GETG(colo))*tmp1)
-> b:=b+((PPM_GETB(colo))*tmp1)
-> sum:=sum+tmp1
r:=r+((PPM_GETR(colo)))
g:=g+((PPM_GETG(colo)))
b:=b+((PPM_GETB(colo)))
sum:=sum+1
ENDFOR
r:=limit(r/sum,0,255)
g:=limit(g/sum,0,255)
b:=limit(b/sum,0,255)
chi:=colormap+(bi*SIZEOF colorhist_item)
chi.color:=PPM_ASSIGN(r,g,b)
ENDFOR
ENDIF
Dispose(bv)
ENDIF
ENDPROC colormap
PROC swapboxes(box1:PTR TO box,box2:PTR TO box)
DEF tmp
tmp:=box1.ind; box1.ind:=box2.ind; box2.ind:=tmp
tmp:=box1.colors; box1.colors:=box2.colors; box2.colors:=tmp
tmp:=box1.sum; box1.sum:=box2.sum; box2.sum:=tmp
tmp:=box1.redw; box1.redw:=box2.redw; box2.redw:=tmp
tmp:=box1.grnw; box1.grnw:=box2.grnw; box2.grnw:=tmp
tmp:=box1.bluw; box1.bluw:=box2.bluw; box2.bluw:=tmp
ENDPROC
PROC computecolorhist(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP)
DEF cht=0
DEF chv=0
cht:=computecolorhash(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP)
IF cht
chv:=colorhashtocolorhist(cht,maxcolors)
freecolorhash(cht)
RETURN chv
ELSE
RETURN 0
ENDIF
ENDPROC
PROC computecolorhash(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP)
DEF cht=0
DEF pP=0
DEF chl=0:PTR TO colorhist_list_item
DEF col,row,hash,ccoolloorr
cht:=alloccolorhash()
IF cht
PutLong(colorsP,0)
row:=0
REPEAT
IF checkcancel(statwindow)
freecolorhash(cht)
Raise("canc")
ENDIF
IF (((row+3)/4)=(row/4))
IF statgauge THEN fuelgauge(statgauge,row,rows-1,stat.histogram_string)
ENDIF
col:=0
REPEAT
ccoolloorr:=((PPM_PUTR(Char(redbuf+pP)) OR PPM_PUTG(Char(grnbuf+pP)) OR PPM_PUTB(Char(blubuf+pP))) AND $FEFEFE)
hash:=HASHPIXEL(ccoolloorr)
chl:=Long(cht+(hash*4))
WHILE (chl<>0)
IF (chl.ch.color=ccoolloorr)
JUMP break
ENDIF
chl:=chl.next
ENDWHILE
break:
IF (chl<>0)
chl.ch.value:=(chl.ch.value+1)
ELSE
PutLong(colorsP,Long(colorsP)+1)
IF Long(colorsP)>maxcolors
freecolorhash(cht)
RETURN 0
ENDIF
-> chl:=New(SIZEOF colorhist_list_item)
chl:=alloc(histopool,SIZEOF colorhist_list_item)
IF chl
chl.ch.color:=ccoolloorr
chl.ch.value:=1
chl.next:=Long(cht+(hash*4))
PutLong((cht+(hash*4)),chl)
ENDIF
ENDIF
col:=col+1;pP:=pP+1;UNTIL col=cols
row:=row+1;UNTIL row=rows
ENDIF
ENDPROC cht
PROC alloccolorhash()
DEF cht=0
cht:=New((HASH_SIZE*4)+20)
ENDPROC cht
PROC colorhashtocolorhist(cht,maxcolors)
DEF chv=0:PTR TO colorhist_item
DEF chl=0:PTR TO colorhist_list_item
DEF i,j
chv:=New((maxcolors*SIZEOF colorhist_item)+20)
j:=0
FOR i:=0 TO (HASH_SIZE-1)
chl:=Long(cht+(i*4))
WHILE (chl<>0)
PutLong(chv+(j*SIZEOF colorhist_item),chl.ch.color)
PutLong(chv+4+(j*SIZEOF colorhist_item),chl.ch.value)
-> WriteF('\n\h \d',chl.ch.color,chl.ch.value)
j:=j+1
chl:=chl.next
ENDWHILE
ENDFOR
ENDPROC chv
PROC freecolorhash(cht)
DEF i
DEF chl:PTR TO colorhist_list_item
DEF chlnext
i:=0
deletepool(histopool)
/* WHILE (i<HASH_SIZE)
chl:=Long(cht+(i*4))
WHILE (chl<>0)
chlnext:=chl.next
-> WriteF('(\z\h[2] \z\h[2] \z\h[2],\z\h[8])\n',PPM_GETR(chl.ch.color),PPM_GETG(chl.ch.color),PPM_GETB(chl.ch.color),chl.ch.value)
Dispose(chl)
chl:=chlnext
ENDWHILE
i:=i+1
ENDWHILE*/
Dispose(cht)
ENDPROC 0
PROC qsort(chv,l,r,and)
DEF i,j,x,m1,m2
-> RETURN
->WriteF('>')
->WriteF('\n\d',FreeStack())
x:=((Long(chv+((Shr(l+r,1))*SIZEOF colorhist_item))) AND and)
i:=l
j:=r
REPEAT
WHILE (((Long(chv+(i++*SIZEOF colorhist_item))) AND and) < x)
-> WriteF('I')
ENDWHILE
WHILE (x<((Long(chv+(j*SIZEOF colorhist_item))) AND and))
j:=j-1
-> WriteF('*')
ENDWHILE
IF (i-- <=j)
-> WriteF('!')
m1:=chv+(j*SIZEOF colorhist_item)
m2:=chv+(i*SIZEOF colorhist_item)
/* MOVE.L j,D0
MULU.L #8,D0
ADD.L chv,D0
MOVE.L i,D1
MULU.L #8,D1
ADD.L chv,D1
MOVE.L D0,A0
MOVE.L D1,A1*/
MOVE.L m1,A0
MOVE.L m2,A1
MOVE.L (A0),D0
MOVE.L (A1),(A0)+
MOVE.L D0,(A1)+
MOVE.L (A0),D0
MOVE.L (A1),(A0)
MOVE.L D0,(A1)
i:=i+1
DEC j
ENDIF
UNTIL i>j
IF l<j THEN qsort(chv,l,j,and)
IF i<r THEN qsort(chv,i,r,and)
-> WriteF('<')
ENDPROC
/*
PROC qsort(chv,l,r,and)
DEF i,j,m1,m2,vand
-> RETURN
->WriteF('Q')
IF (r>l)
vand:=((Long(chv+(r*SIZEOF colorhist_item))) AND and)
i:=l-1
j:=r
WHILE (1=1)
m2:=TRUE
REPEAT
i:=i+1
IF (((Long(chv+(i*SIZEOF colorhist_item))) AND and)>=vand) THEN m2:=FALSE
IF i>=r THEN m2:=FALSE
->WriteF('i')
UNTIL m2=FALSE
m2:=TRUE
REPEAT
j:=j-1
IF (((Long(chv+(j*SIZEOF colorhist_item))) AND and)<=vand) THEN m2:=FALSE
IF j<=l THEN m2:=FALSE
->WriteF('j')
UNTIL m2=FALSE
IF (i>=j) THEN JUMP break6
->WriteF('#')
m1:=chv+(j*SIZEOF colorhist_item)
m2:=chv+(i*SIZEOF colorhist_item)
MOVE.L m1,A0
MOVE.L m2,A1
MOVE.L (A0),D0
MOVE.L (A1),(A0)+
MOVE.L D0,(A1)+
MOVE.L (A0),D0
MOVE.L (A1),(A0)
MOVE.L D0,(A1)
ENDWHILE
break6:
->WriteF('*')
IF (i<r)
m1:=chv+(r*SIZEOF colorhist_item)
m2:=chv+(i*SIZEOF colorhist_item)
MOVE.L m1,A0
MOVE.L m2,A1
MOVE.L (A0),D0
MOVE.L (A1),(A0)+
MOVE.L D0,(A1)+
MOVE.L (A0),D0
MOVE.L (A1),(A0)
MOVE.L D0,(A1)
ENDIF
qsort(chv,l,i-1,and)
qsort(chv,i+1,r,and)
ENDIF
ENDPROC
*/
PROC doexchange(cmap,pen,r,g,b,uhp)
DEF newpen
newpen:=findcolorbytes(cmap,r,g,b,uhp)
exchangecolorcmap(cmap,pen,newpen)
ENDPROC
PROC sizebox(box:PTR TO box,chv)
DEF i,ptr:PTR TO colorhist_item
DEF mr=255,mg=255,mb=255,xr=0,xg=0,xb=0
DEF color,r,g,b
ptr:=chv+(box.ind*SIZEOF colorhist_item)
FOR i:=0 TO box.colors-1
color:=ptr.color
MOVE.L color,D0
MOVE.L D0,D1
AND.L #$FF,D1
MOVE.L D1,b
LSR.L #8,D0
MOVE.L D0,D1
AND.L #$FF,D1
MOVE.L D1,g
LSR.L #8,D0
MOVE.L D0,D1
AND.L #$FF,D1
MOVE.L D1,r
IF (r<mr) THEN mr:=r
IF (g<mg) THEN mg:=g
IF (b<mb) THEN mb:=b
IF (r>xr) THEN xr:=r
IF (g>xg) THEN xg:=g
IF (b>xb) THEN xb:=b
ptr:=ptr+SIZEOF colorhist_item
ENDFOR
box.redw:=xr-mr
box.grnw:=xg-mg
box.bluw:=xb-mb
-> WriteF('\n (\d,\d,\d) \d',box.redw,box.grnw,box.bluw,box.colors)
ENDPROC